home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 674 / start / startlow.gfa (.txt) < prev   
Encoding:
GFA-BASIC Atari  |  1986-10-19  |  9.5 KB  |  459 lines
  1. ' ********************
  2. ' *** STARTLOW.GFA ***
  3. ' ********************
  4. ' *** this program runs in Low resolution only
  5. ' *** 'Shell'-program for running *.GFA-programs in Low resolution
  6. ' *** GFA-programs should exit with CHAIN "\STARTLOW.GFA"
  7. ' *** © Han Kempen (22-4-1990)
  8. '
  9. DEFWRD "a-z"
  10. '
  11. start$="\STARTLOW.INF"          ! last path saved here
  12. scrn.col.max&=40                 ! screenwidth 40 characters
  13. '
  14. CLS
  15. ' @check.boot                   ! check for boot-virus (not activated)
  16. @low.mode                       ! check resolution : quit if High or Medium
  17. low.res!=TRUE
  18. '
  19. drive$=CHR$(65+GEMDOS(25))      ! problem: this is the GFABASIC.PRG-drive !
  20. '
  21. bytes%=DFREE(0)                 ! slow on harddisk, unless FATSPEED installed
  22. current$="p "+drive$+" q "+STR$(bytes%)+" bytes free"
  23. '
  24. IF EXIST(start$)
  25.   OPEN "I",#1,start$            ! last accessed folder in STARTLOW.INF
  26.   INPUT #1,path$
  27.   CLOSE #1
  28. ELSE
  29.   path$=drive$+":\"             ! main directory
  30. ENDIF
  31. '
  32. @standard.low.colors
  33. '
  34. IF PEEK(&H444)<>0               ! first time after reset ? (not perfect)
  35.   SPOKE &HFF820A,252            ! * NOT * if you use a TV through a modulator !
  36.   PRINT
  37.   PRINT " Vertical frequency now 60 Hz"
  38.   SPOKE &H444,0
  39.   PRINT
  40.   PRINT " Write Verify Test switched off"
  41.   '
  42.   IF VAL(RIGHT$(DATE$,2))<88            ! date not set ? (not perfect either)
  43.     HIDEM
  44.     LOCATE 1,9
  45.     PRINT @center$("STARTLOW-SHELL")
  46.     LOCATE 1,17
  47.     PRINT @center$("GFA-BASIC 3.0")
  48.     DEFLINE 1,3
  49.     RBOX 2*8,10*8,38*8,15*8
  50.     LOCATE 4,12
  51.     @start.date.input
  52.     LOCATE 4,14
  53.     @start.time.input                   ! just press <Return> if you don't care
  54.     DEFLINE 1,1
  55.     SHOWM
  56.   ENDIF
  57.   '
  58. ENDIF
  59. '
  60. CLS
  61. bottom$=current$
  62. LOCATE 1,25
  63. PRINT @center$(bottom$);
  64. m$="Choose *.GFA-file      <Cancel> = Quit"
  65. REPEAT
  66.   @fileselect(path$+"*.GFA","",m$,file$)
  67. UNTIL file$="" OR RIGHT$(file$)="\" OR RIGHT$(file$,4)=".GFA"
  68. '
  69. CLS
  70. IF file$="" OR RIGHT$(file$)="\"
  71.   ' *** user wants to quit
  72.   IF EXIST(start$)
  73.     KILL start$                 ! kill file STARTLOW.INF
  74.   ENDIF
  75.   SETMOUSE 160,112
  76.   m$="|Go to GFA-editor|       or|return to Desktop ?"
  77.   ALERT 3,m$,1,"EDIT|DESK",k&
  78.   IF k&=1
  79.     NEW
  80.   ELSE
  81.     SYSTEM
  82.   ENDIF
  83. ELSE
  84.   ' *** user chose GFA-program
  85.   @parse.filename(file$,d$,p$,f$,e$)
  86.   path$=d$+":"+p$
  87.   OPEN "O",#1,start$
  88.   PRINT #1,path$        ! remember last path
  89.   CLOSE #1
  90.   CHDRIVE path$
  91.   CHDIR path$           ! essential for Standard Procedure Get.path in file$ !!
  92.   CHAIN file$           ! start the GFA-progam
  93. ENDIF
  94. '
  95. ' ------------------------------------------------------------------------------
  96. '
  97. DEFFN center$(text$)=SPACE$((scrn.col.max&-LEN(text$))/2)+text$
  98. '
  99. > PROCEDURE check.boot
  100.   ' *** compute checksum of bootsector and warn user if bootsector executable
  101.   LOCAL drive&,buffer$,buffer%,sum%,n&,m$
  102.   PRINT " Checking boot-sector ..."
  103.   drive&=GEMDOS(&H19)
  104.   buffer$=SPACE$(512)
  105.   buffer%=VARPTR(buffer$)
  106.   ~BIOS(4,0,L:buffer%,1,0,drive&)    ! bootsector (0) of current drive in buffer
  107.   sum%=0
  108.   FOR n&=0 TO 255
  109.     ADD sum%,CARD{buffer%+n&*2}
  110.   NEXT n&
  111.   sum%=sum% AND &HFFFF
  112.   IF sum%=&H1234
  113.     m$="Bootsector|executable :|this could be|a boot-virus"
  114.     ALERT 3,m$,2," OK |STOP",k&
  115.   ENDIF
  116. RETURN
  117. ' **********
  118. '
  119. > PROCEDURE low.mode
  120.   LOCAL m$,button&
  121.   IF XBIOS(4)<>0
  122.     SOUND 1,10,12,4,25
  123.     SOUND 1,10,6,4,25
  124.     SOUND 1,10,12,4,50
  125.     SOUND 1,0
  126.     m$="Sorry, you should|use Low resolution|for this shell"
  127.     ALERT 3,m$,1," OK ",button&
  128.     IF EXIST(interpreter$)
  129.       EDIT
  130.     ELSE
  131.       SYSTEM
  132.     ENDIF
  133.   ENDIF
  134. RETURN
  135. ' **********
  136. '
  137. > PROCEDURE get.path(VAR default.path$)
  138.   ' *** return default path (current drive and folder)
  139.   ' *** e.g. A:\GAMES\
  140.   LOCAL default.drive&,default.drive$,buffer$,buffer%
  141.   CLR default.path$
  142.   default.drive&=GEMDOS(&H19)
  143.   default.drive$=CHR$(default.drive&+65)
  144.   buffer$=SPACE$(64)
  145.   buffer%=VARPTR(buffer$)
  146.   VOID GEMDOS(&H47,L:buffer%,0)
  147.   default.path$=CHAR{buffer%}
  148.   IF default.path$<>""
  149.     default.path$=default.drive$+":"+default.path$+"\"
  150.   ELSE
  151.     default.path$=default.drive$+":\"
  152.   ENDIF
  153. RETURN
  154. ' **********
  155. '
  156. > PROCEDURE standard.low.colors
  157.   ' *** standard-colors for Low resolution
  158.   LOCAL n&,col$,r&,g&,b&
  159.   RESTORE col.data
  160.   FOR n&=0 TO 15
  161.     READ col$
  162.     r&=VAL(LEFT$(col$))
  163.     g&=VAL(MID$(col$,2,1))
  164.     b&=VAL(RIGHT$(col$))
  165.     VSETCOLOR n&,r&,g&,b&
  166.   NEXT n&
  167.   '
  168. col.data:
  169.   DATA 777,000,700,060,007,005,520,050,555,111,077,053,707,505,550,770
  170. RETURN
  171. ' **********
  172. '
  173. > PROCEDURE start.date.input
  174.   ' *** input of date
  175.   ' *** accepts different formats (day-month-year), e.g. :
  176.   ' *** 1-6-'88   02-11-88   3.6.88   2/1/88   12 June 1988   9 Aug 88
  177.   LOCAL x&,y&,date.input$,ok!,day$,day&,month.input$,month$,n&,month!,month&,year$,year&
  178.   LOCAL new.date$
  179.   PRINT " Date (dd.mm.yy)   : ";
  180.   x&=CRSCOL
  181.   y&=CRSLIN
  182.   ON ERROR GOSUB start.date.input.error
  183.   '
  184. start.date.input:
  185.   ' *** input of date
  186.   ok!=TRUE
  187.   FORM INPUT 18,date.input$
  188.   ' *** day
  189.   day.len&=VAL?(date.input$)
  190.   IF day.len&>2
  191.     IF INSTR(date.input$,".")=2
  192.       day.len&=1
  193.     ELSE
  194.       IF INSTR(date.input$,".")=3
  195.         day.len&=2
  196.       ELSE
  197.         ok!=FALSE
  198.       ENDIF
  199.     ENDIF
  200.   ENDIF
  201.   day$=LEFT$(date.input$,day.len&)
  202.   day&=VAL(day$)
  203.   IF day&>31 OR day&<1
  204.     ok!=FALSE
  205.   ENDIF
  206.   ' *** mmonth
  207.   month.input$=RIGHT$(date.input$,LEN(date.input$)-(day.len&+1))
  208.   month.len&=VAL?(month.input$)
  209.   IF month.len&=0
  210.     month$=LEFT$(month.input$,3)
  211.     month$=UPPER$(month$)
  212.   start.month.data:
  213.     DATA JAN,1,FEB,2,MAR,3,APR,4,MAY,5,JUN,6,JUL,7
  214.     DATA AUG,8,SEP,9,OCT,10,NOV,11,DEC,12
  215.     DIM date.input.month$(12),date.input.month&(12)
  216.     RESTORE start.month.data
  217.     FOR n&=1 TO 12
  218.       READ date.input.month$(n&),date.input.month&(n&)
  219.     NEXT n&
  220.     FOR n&=1 TO 12
  221.       IF date.input.month$(n&)=month$
  222.         month!=TRUE
  223.         month&=date.input.month&(n&)
  224.       ENDIF
  225.     NEXT n&
  226.     ERASE date.input.month$()
  227.     ERASE date.input.month&()
  228.     IF NOT month!
  229.       ok!=FALSE
  230.     ENDIF
  231.   ELSE
  232.     month&=VAL(month.input$)
  233.   ENDIF
  234.   IF month&>12 OR month&<1
  235.     ok!=FALSE
  236.   ENDIF
  237.   month$=STR$(month&)
  238.   IF (month&=4 OR month&=6 OR month&=9 OR month&=11) AND day&>30
  239.     ok!=FALSE
  240.   ENDIF
  241.   IF (month&=1 OR month&=3 OR month&=5 OR month&=7 OR month&=8 OR month&=10 OR month&=12) AND day&>31
  242.     ok!=FALSE
  243.   ENDIF
  244.   ' *** year
  245.   year$=RIGHT$(date.input$,2)
  246.   IF VAL?(year$)<>2 OR INSTR(year$,".") OR VAL(year$)<88
  247.     ok!=FALSE
  248.   ENDIF
  249.   year&=VAL(year$)
  250.   IF month&=2
  251.     IF day&>28
  252.       IF (year& MOD 400=0) AND day&<>29
  253.         ok!=FALSE
  254.       ELSE
  255.         IF year& MOD 100=0 AND (year& MOD 400<>0)
  256.           ok!=FALSE
  257.         ELSE
  258.           IF (year& MOD 4=0) AND day&<>29
  259.             ok!=FALSE
  260.           ELSE
  261.             IF (year& MOD 4<>0)
  262.               ok!=FALSE
  263.             ENDIF
  264.           ENDIF
  265.         ENDIF
  266.       ENDIF
  267.     ENDIF
  268.   ENDIF
  269.   ' *** print date
  270.   IF NOT ok!
  271.     PRINT CHR$(7);
  272.     PRINT AT(x&,y&);STRING$(LEN(date.input$)," ");
  273.     PRINT AT(x&,y&);"WRONG FORMAT !!";
  274.     PAUSE 50
  275.     PRINT AT(x&,y&);STRING$(18," ");
  276.     PRINT AT(x&,y&);"";
  277.     GOTO start.date.input
  278.   ENDIF
  279.   LET new.date$=day$+"."+month$+"."+year$
  280.   SETTIME TIME$,new.date$
  281.   ON ERROR
  282. RETURN
  283. ' ***
  284. > PROCEDURE start.date.input.error
  285.   ' *** unexpected error
  286.   ok!=FALSE
  287.   ON ERROR GOSUB start.date.input.error
  288.   RESUME NEXT
  289. RETURN
  290. ' **********
  291. '
  292. > PROCEDURE start.time.input
  293.   ' *** input of time (seconds optional)
  294.   ' *** <Return> = 00:00:00
  295.   ' *** accepts different formats, e.g. :
  296.   ' *** 12.40.10    1:30:25    20.45
  297.   '
  298.   LOCAL x&,y&,ok!,time.input$,hour.len&,hour$,minute.input$,minute.len&
  299.   LOCAL minute$,second$,second.input$,second.len&,new.time$
  300.   PRINT " Time (hh.mm[.ss]) : ";
  301.   x&=CRSCOL
  302.   y&=CRSLIN
  303.   ON ERROR GOSUB start.time.input.error
  304.   '
  305. start.time.input:
  306.   ' *** input of time
  307.   ok!=TRUE
  308.   FORM INPUT 10,time.input$
  309.   IF time.input$=""
  310.     LET new.time$="00:00:00"
  311.     GOTO start.time.exit
  312.   ENDIF
  313.   ' *** hour
  314.   hour.len&=VAL?(time.input$)
  315.   IF hour.len&>2
  316.     IF INSTR(time.input$,".")=2
  317.       hour.len&=1
  318.     ELSE
  319.       IF INSTR(time.input$,".")=3
  320.         hour.len&=2
  321.       ELSE
  322.         ok!=FALSE
  323.       ENDIF
  324.     ENDIF
  325.   ENDIF
  326.   hour$=LEFT$(time.input$,hour.len&)
  327.   IF VAL(hour$)>23
  328.     ok!=FALSE
  329.   ENDIF
  330.   ' *** minutes
  331.   LET minute.input$=RIGHT$(time.input$,LEN(time.input$)-(hour.len&+1))
  332.   LET minute.len&=VAL?(minute.input$)
  333.   IF minute.len&>2
  334.     IF INSTR(minute.input$,".")=2
  335.       LET minute.len&=1
  336.     ELSE
  337.       IF INSTR(minute.input$,".")=3
  338.         LET minute.len&=2
  339.       ELSE
  340.         ok!=FALSE
  341.       ENDIF
  342.     ENDIF
  343.   ENDIF
  344.   LET minute$=LEFT$(minute.input$,minute.len&)
  345.   IF VAL(minute$)>59
  346.     ok!=FALSE
  347.   ENDIF
  348.   ' *** seconds
  349.   IF minute.len&>=LEN(minute.input$)-1
  350.     second$="0"
  351.   ELSE
  352.     second.input$=RIGHT$(minute.input$,LEN(minute.input$)-(minute.len&+1))
  353.     second$=LEFT$(second.input$,2)
  354.     IF VAL(second$)>59
  355.       ok!=FALSE
  356.     ENDIF
  357.   ENDIF
  358.   ' *** tijd
  359.   IF NOT ok!
  360.     PRINT CHR$(7);
  361.     PRINT AT(x&,y&);STRING$(LEN(time.input$)," ");
  362.     PRINT AT(x&,y&);"WRONG !!";
  363.     PAUSE 50
  364.     PRINT AT(x&,y&);STRING$(10," ");
  365.     PRINT AT(x&,y&);"";
  366.     GOTO start.time.input
  367.   ENDIF
  368.   LET new.time$=hour$+":"+minute$+":"+second$
  369. start.time.exit:
  370.   SETTIME new.time$,DATE$
  371.   ON ERROR
  372. RETURN
  373. ' ***
  374. > PROCEDURE start.time.input.error
  375.   ' *** unexpected error
  376.   ok!=FALSE
  377.   ON ERROR GOSUB start.time.input.error
  378.   RESUME NEXT
  379. RETURN
  380. ' **********
  381. '
  382. > PROCEDURE fileselect(path$,default$,txt$,VAR file$)
  383.   ' *** use Fileselector with comment-line
  384.   ' *** comment-line max. 38 characters in all resolutions
  385.   ' *** uses Standard Function and Globals
  386.   PRINT AT(1,3);@center$(txt$)
  387.   GRAPHMODE 3
  388.   DEFFILL 1,1           ! black
  389.   BOUNDARY 0
  390.   IF high.res!
  391.     BOX 157,25,482,54
  392.     PLOT 157,25
  393.     PBOX 159,27,480,52
  394.   ELSE IF med.res!
  395.     BOX 157,12,482,27
  396.     PLOT 157,12
  397.     PBOX 160,14,479,24
  398.   ELSE IF low.res!
  399.     BOX 0,12,319,27
  400.     PLOT 0,12
  401.     PBOX 2,14,317,24
  402.   ENDIF
  403.   BOUNDARY 1
  404.   GRAPHMODE 1
  405.   FILESELECT path$,default$,file$
  406. RETURN
  407. ' **********
  408. '
  409. > PROCEDURE parse.filename(parse.name$,VAR drive$,path$,file$,ext$)
  410.   ' *** return drive, path, filename (without extension !) and extension
  411.   ' *** no checking for correct syntax
  412.   ' *** example : "A:\GAMES\PLAY.GFA" returned as :  A  \GAMES\  PLAY  GFA
  413.   ' ***           "A:\PLAY.GFA"       returned as :  A  \        PLAY  GFA
  414.   LOCAL pos&,first&,last&,last!,search&,parse.file$
  415.   '
  416.   parse.name$=UPPER$(parse.name$)
  417.   IF MID$(parse.name$,2,1)=":"
  418.     drive$=LEFT$(parse.name$,1)
  419.   ELSE
  420.     drive$=CHR$(65+GEMDOS(&H19))    ! current drive
  421.   ENDIF
  422.   '
  423.   pos&=1
  424.   last!=FALSE
  425.   last&=0
  426.   first&=INSTR(1,parse.name$,"\")
  427.   REPEAT
  428.     search&=INSTR(pos&,parse.name$,"\")
  429.     IF search&>0
  430.       pos&=search&+1
  431.       last&=search&
  432.     ELSE
  433.       last!=TRUE
  434.     ENDIF
  435.   UNTIL last!
  436.   IF last&>0                              ! backslash discovered
  437.     path$=MID$(parse.name$,first&,last&-first&+1)
  438.     parse.file$=MID$(parse.name$,last&+1)
  439.   ELSE                                   ! no '\'
  440.     path$=""
  441.     pos&=INSTR(1,parse.name$,":")
  442.     IF pos&>0
  443.       parse.file$=MID$(parse.name$,pos&+1)
  444.     ELSE
  445.       parse.file$=parse.name$
  446.     ENDIF
  447.   ENDIF
  448.   pos&=INSTR(parse.file$,".")
  449.   IF pos&>0                               ! name with extension
  450.     ext$=MID$(parse.file$,pos&+1)
  451.     file$=LEFT$(parse.file$,pos&-1)
  452.   ELSE                                   ! name without extension
  453.     ext$=""
  454.     file$=parse.file$
  455.   ENDIF
  456. RETURN
  457. ' **********
  458. '
  459.